#!/usr/bin/perl
#USAGE: perl lab2blf.pl -lab SOURCEFOLDER -sent SENTENCEFILE -list LIST [-rate SAMPLINGRATE -v -h]
#the input format for the SENTENCEFILE: transcription line, orthographic line and s.o.; the first Word" in each transcription line has to be a 
#sentence identifier or a non-significant string
#v: verbose output (prints out every phone-character processing during extracting stress and syllable symbols

#Version: 1.2
#@autor: Stefan Breuer
#@autor: Igor Jauk
#@autor: Filip Müllers

#changes from 1.0:
#detects word boundaries from the sentencefile instead of using the last column in the lab files (beacuase wavesurfer removes the column in case of modifying the lab files)
#provides better error tracking in sentences
#corrections in time calculation for blfs
#taking into account sp-puases and removing of empty sps (with duration 0)

#changes from 1.1
#using the config class
#using an extern filelist
#minor code improvements

use FindBin qw($Bin);
use lib "$Bin/../libs";
use config;

my $USAGE = "perl lab2blf.pl -lab LABFOLDER -sent SENTENCEFILE -list FILELIST [-rate SAMPLINGRATE -v -h]";

my $cl = config->new(\@ARGV);
if ($cl->optionflag("-h")) {
	print $USAGE."\n";
	exit;
}

if ($cl->optionflag("-rate")) {
	$rate = $cl->optionarg("-rate");	#sampling rate; keep it global
} else {
	$rate = 16000;
	print STDERR "No sampling rate specified. Using the default value of 16000 Hz (default for BOSS).\n";
}
if ($cl->optionflag("-sent")) {
	$sent = $cl->optionarg("-sent");	#file that contains the sentences
} else {
	die "error: sentence file not specified. terminating application\n";
}



#$list = "list.txt";	#file that contains a List of lab-fies
$stressline = 'uioayeEUIOAY629@';

print "\n";
print ("============================\n");
print ("|     CHECKING FOLDERS     |\n");
print ("============================\n");
print "\n";


if (!-d "blf") {
	mkdir "blf";
	print STDERR "  folder \"blf\" : created!\n";
} 
else {
	print STDERR "  folder \"blf\" : OK!\n";
}
print "\n";
print ("============================\n");
print ("|      FETCHING FILES      |\n");
print ("============================\n");
print "\n";


my $listfile = $cl->optionarg("-list");
open LIST, "$listfile" or die "could not open filelist $list\n";
chomp(my @list = <LIST>);
close(LIST);


die "error: source folder not specified. terminating application.\n" if (!$cl->optionflag("-lab"));
die "error: filelist not specified. terminating application.\n" if (!$cl->optionflag("-list"));

open IN, "$sent" or die "  couldn't open sentencefile: $sent\n";
print("  open DONE....$sent\n");
chomp(my @sent = <IN>);
close(IN);
my $n=0;
print "\n";
print ("============================\n");
print ("| LET'S DO SOME CONVERSION |\n");
print ("============================\n");
print "\n";
foreach (@list){
#print "change in progress...";
#print "\n";
#print "\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b";
	$list[$n] =~ s/\....$//;
  $file = $list[$n];
  checkPHRWords(\@sent, \$cl);		#checks which words "carry" a phrase boundary
  my $trans = $sent[0];
  shift(@sent);
  $trans =~ s/^([^ ]*) //;
  my $sentID = $1;
  #$$tr =~ s/#//g;				#removes word boundaries from sentence here!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1111
  my $stress = 0;	#stress marc to set stress only at stressline units
  my $tdir = $cl->optionarg("-lab");
  my $wmarc = 0;
  my $PHR = 'NULL';
  open (FILE, "$tdir/$list[$n].lab") or die "couldn't open $tdir/$list[$n].lab\n";
  chomp(my @arreingabe = <FILE>);
  my $i=0;
  $newfile = "blf/$list[$n]".".blf";
  open (AUS, ">$newfile") or die ("couldn't write file \".$newfile.");
  foreach (@arreingabe) {
    # Each row in its own array, 
    # Second column  contains the BOSS - SAMPA annotation
    $arreingabe[$i] =~ s/sil/#\$p/;
    $arreingabe[$i] =~ s/sp/#\$p/;
    $arreingabe[$i] =~ s/\'/\"/;
    $arreingabe[$i] =~ s/\\//g;
    #$arreingabe[$i] =~ s/\\//;
    my @splitted = split(/ /, $arreingabe[$i]);
    if ($splitted[2] ne '#$p'){
      # First column has to be recalculated
	 encode(\@splitted, \$trans);
	#get the syllable boundaries and the stress marcs
	#print $$tr."\n";
	getSyllNStress(\@splitted, \$trans, \$stress, \$sentID, \$wmarc, \$PHR, \$cl);
	$PHR =~ s/#/\?/;
	$PHR =~ s/-/!/;
	$PHR =~ s/=/\./;
	#print $PHR."\n";
	decode(\@splitted);  
      # Third Column
	#if (defined $splitted[4]) {				#necessary check the 4th column??
	#	$splitted[2] = '#'.$splitted[2];		#get word boundary
	#	$acc = getPhrase($s, $splitted[4]);
	#} elsif ($wmarc == 1) {
	if ($wmarc == 1) {
		$splitted[2] = '#'.$splitted[2];		#get word boundary
		$wmarc = 0;
	}
      $i++;
      }
    elsif ($splitted[2] eq '#$p') {
      if ($splitted[0]==$splitted[1]) {
	  $i++;
	  next;
      }
      $i++;
    }
	  my $time = \$splitted[0];
	  $splitted[0] = convertToSamples($time);
	  round(\@splitted);		#rounding necessary because the time in the lab files is given in microseconds, which contains 0.016 samples and in blfs the time is given in samples (integers)
	#remove '#' in front of the final phones of words
	#$splitted[2] =~ s/#//g if !defined $splitted[4];

        print AUS ($splitted[0]."\t". $splitted[2]);
	if ($PHR ne 'NULL') {
		print AUS "\t$PHR\n";
		$PHR = 'NULL';
	}
	else {	
		print AUS "\n";
	}
  };
  shift(@sent);
$n++;
}
print "\n";
print "\n";
print ("============================\n");
print ("|    ALL CHANGING DONE     |\n");
print ("============================\n");
print "\n";
close(AUS);

sub convertToSamples {
	return ((${$_[0]}*$rate)/10000000);	#the time in the labfiles is given in microseconds, thats why devide through 1 000 000
}

sub round {
	my $line = $_[0];
	my $buff = int($line->[0]);
	if ($line->[0] == $buff) {
	    return;
	} elsif (($line->[0] - $buff) >= 0.5) {
	    $line->[0] = $buff + 1;
	} elsif (($line->[0] - $buff) < 0.5) {
	    $line->[0] = $buff;
	}
}

sub checkPHRWords {
	my $s = $_[0];
	my $cl = $_[1];
	my @orth = split(/ +/,$s->[1]);
	my @trans = split(/ +/,$s->[0]);
	if (@orth != @trans-1) {
	    die "error: the number of words in the orthographic and the transcribed sentences is not equal. aborting.\n";
	}
	for (my $i=0; $i<@orth; $i++) {
		if ($orth[$i] =~ /[,\.\?!:]/) {
		#match the $trans[$i] with the sentence and replace the word in the sentence with $trans[$i] with some symbol at the beginning, which indicates a phrase boundary
		#then i can return a marc and set the appropriate phrase boundary into the blf
		    my $phr = getPhrase(\$orth[$i]);
		    #print "BUFU $s->[0]\n";
		    $trans[$i+1] =~ s/\?/!/g;
		    $s->[0] =~ s/\?/!/g;
		    $trans[$i+1] =~ s/\./§/g;
		    $s->[0] =~ s/\./§/g;
		    $s->[0] =~ s/([^_])$trans[$i+1]/$1_$phr _$trans[$i+1]/;
		    $s->[0] =~ s/!/\?/g;
		    $s->[0] =~ s/§/\./g;
		    print "PHR findings: ".$orth[$i]."    $trans[$i+1]    $s->[0]\n" if $$cl->optionflag('-v');
		}
	}
}

sub getPhrase {
	my $b = $_[0];
	if ($$b =~ /\,/) {
		return('2,#');
		print "2,?"
	} elsif ($$b =~ /\!/) {
		return('5,-');
		print "5,!"
	} elsif ($$b =~ /\?/) {
		return('5,#');
		print "5,?"
	} elsif ($$b =~ /\./) {
		return('5,=');
		print "5,."
	} elsif ($$b =~ /\:/) {
		return('5,=');
		print "5,."
	} else {
		return('NULL');
	}
}


#sub getPhrase {
#	#print $_[0]->[1]."\n $_[1]\n";
#	my @buff = split(/ +/, $_[0]->[0]);
#	foreach $b (@buff) {
#		#print $b,"   ",$_[1],"\n";
#		if ($b =~ /$_[1]/i) {
#			if ($b =~ /\,/) {
#				return('2,?');
#				print "2,?"
#			}
#			elsif ($b =~ /\!/) {
#				return('5,!');
#				print "5,!"
#			}
#			elsif ($b =~ /\?/) {
#				return('5,?');
#				print "5,?"
#			}
#			elsif ($b =~ /\./) {
#				return('5,.');
#				print "5,."
#			}
#			elsif ($b =~ /\:/) {
#				return('5,.');
#				print "5,."
#			}
#			else {
#				return('0');
#			}
#		}
#	}
#}

sub getSyllNStress {
	#$_[0]: pointer to splitted; $_[1]: pointer to the transcribed sentence
	#$_[2]: pointer to stress; $_[3]: sentence ID; $_[4]: wmarc; $_[5]: PHRmarc, $_[6]: $cl
	my $cl = $_[6];
	#get stress
	print "Sentence: ${$_[3]} ".${$_[1]}."\n" if $$cl->optionflag('-v');
	print "Phone: ".$_[0]->[2]."\n" if $$cl->optionflag('-v');
	${$_[1]} =~ s/^ +//;
	if (${$_[1]} =~ s/^_(\d,.) _//) {		#check phrase marc
		#print "BUUUUUUUFFFFFFFFFFFFFFFFFFFUUUUUUUUUUUUUUUU\n";
		${$_[5]} = $1;
	}
	if (${$_[1]} =~ s/NULL//) {
		${$_[5]} = 'NULL';
	}
	if (${$_[1]} =~ s/^#//) {	#check word boundary
		 ${$_[4]} = 1;
	}
	if (${$_[2]} == 1) {
		if (${$_[1]} =~ s/^$_[0]->[2]//) {
			my @first = split(//,$_[0]->[2]);
			stressSet($first[0],$_[0],$_[2]);
			return;
		} elsif (${$_[1]} =~ s/^'//) {
			print STDERR "Warning: two adjacent stress symbols found in $_[0]->[2] in the transcribed sentence ${$_[3]}.\nproceeding to further processing\n";
		} else {
			print STDERR "Warning: stress marc is set true but no adequate transcription symbol found in transcribed sentence ${$_[3]}.\nproceeding to further processing.\n";
		}
	}
	if (${$_[2]} == 2) {
		if (${$_[1]} =~ s/^$_[0]->[2]//) {
			my @first = split(//,$_[0]->[2]);
			stressSet2($first[0],$_[0],$_[2]);
			return;
		} elsif (${$_[1]} =~ s/^'// || ${$_[1]} =~ s/^%//) {
			print STDERR "Warning: two adjacent stress symbols found in $_[0]->[2] in the transcribed sentence ${$_[3]}. \nproceeding to further processing\n";
		} else {
			print STDERR "Warning: stress marc is set true but no adequate transcription symbol found in transcribed sentence ${$_[3]}.\nproceeding to further processing.\n";
		}
	}
	if (${$_[1]} =~ s/^$_[0]->[2]//) {
		#print ${$_[1]}."\n";
		return;
	} elsif ($_[0]->[2] =~ /\$p/) {
		return;
	} else {
		#find stress. if found a stress symbol check if the next symbol is a phone
		#symbol; if so, check if it is in the stressline; if so, put a stress symbol
		#into the blf; if it's not in the stressline put a marc and wait until a stressline
		#symbol has been found; if the next symbol is not a phone symbol, put a syllable
		#symbol first and then a stress symbol; if the next symbol is not a phone symbol 
		#and not a syllable symbol, print an error message.
		#after that do the same thing once again for the case if find a syllable symbol first
		if (${$_[1]} =~ s/^'//) {
			my @first = split(//,$_[0]->[2]);
			#print $first[0]."\n";
			if (${$_[1]} =~ s/^$_[0]->[2]//) {
				stressSet($first[0],$_[0],$_[2]);
			} elsif (${$_[1]} =~ s/^\.//) {
				if (${$_[1]} =~ s/^$_[0]->[2]//) {
					stressSet($first[0],$_[0],$_[2]);
					$_[0]->[2] = '.'.$_[0]->[2];
				} else {
					die "error1: transcrption symbol $_[0]->[2] not found in the transcribed sentence ${$_[3]}\n${$_[1]}\ntranscriped sentence modified?\n";
				}
			} else {
				die "error2: transcrption symbol $_[0]->[2] not found in the transcribed sentence ${$_[3]}\n${$_[1]}\ntranscriped sentence modified?\n";
			}
		} elsif (${$_[1]} =~ s/^\.//) {
			if (${$_[1]} =~ s/^$_[0]->[2]//) {
				$_[0]->[2] = '.'.$_[0]->[2];
			} elsif (${$_[1]} =~ s/^'//) {
				my @first = split(//,$_[0]->[2]);
				if (${$_[1]} =~ s/^$_[0]->[2]//) {
					stressSet($first[0],$_[0],$_[2]);
					$_[0]->[2] = '.'.$_[0]->[2];
				} else {
					die "error3: transcrption symbol $_[0]->[2] not found in the transcribed sentence ${$_[3]}\n${$_[1]}\ntranscriped sentence modified?\n";
				}
			} elsif (${$_[1]} =~ s/^%//) {
				my @first = split(//,$_[0]->[2]);
				if (${$_[1]} =~ s/^$_[0]->[2]//) {
					stressSet2($first[0],$_[0],$_[2]);
					$_[0]->[2] = '.'.$_[0]->[2];
				} else {
					die "error3: transcrption symbol $_[0]->[2] not found in the transcribed sentence ${$_[3]}\n${$_[1]}\ntranscriped sentence modified?\n";
				}
			} else {
				die "error4: the transcribed sentence in the sentence file and in the .lab file do not coincide.\nlab or transcription file modified?\n";
			}
		} elsif (${$_[1]} =~ s/^%//) {
			my @first = split(//,$_[0]->[2]);
			if (${$_[1]} =~ s/^$_[0]->[2]//) {
				stressSet2($first[0],$_[0],$_[2]);
			} elsif (${$_[1]} =~ s/^\.//) {
				if (${$_[1]} =~ s/^$_[0]->[2]//) {
					stressSet2($first[0],$_[0],$_[2]);
					$_[0]->[2] = '.'.$_[0]->[2];
				} else {
					die "error1: transcrption symbol $_[0]->[2] not found in the transcribed sentence ${$_[3]}\n${$_[1]}\ntranscriped sentence modified?\n";
				}
			} else {
				die "error2: transcrption symbol $_[0]->[2] not found in the transcribed sentence ${$_[3]}\n${$_[1]}\ntranscriped sentence modified?\n";
			}
		} 
	}
}

sub stressSet {
	if ($stressline =~ /$_[0]/) {
		$_[1]->[2] = '"'.$_[1]->[2];
		${$_[2]} = 0;
	} else {
		${$_[2]} = 1;
	}
}

sub stressSet2 {
	if ($stressline =~ /$_[0]/) {
		$_[1]->[2] = '%'.$_[1]->[2];
		${$_[2]} = 0;
	} else {
		${$_[2]} = 2;
	}
}

sub encode {
	$_[0]->[2] =~ s/\?/!/g;
	${$_[1]} =~ s/\?/!/g;
}

sub decode {
	$_[0]->[2] =~ s/!/\?/g;
}
